Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/bufferio.zip/BUFFERIO.PAS

Pascal/Delphi Source File | 1993-01-04 | 7KB | 263 lines

UNIT BufferIO;

{ BufferIO version 0.9: BETA!  This unit may or may not work.        }
{ This program is released into the public domain by its author (me) }
{ Bruce Feist.  }

{ However, I respectfully request the following: }

{  If you redistribute it, please clearly indicate what changes you have }
{ made (if any).  Please don't delete or alter this notice, either.      }
{ And, please include all other materials that you received with it      }
{ (a documentation file and a driver program to test it).  Also, please  }
{ do NOT include any compiled code.  JUST include the .PAS files and     }
{ documentation.  That should make it harder to infect with any viruses! }

{   Anyway, please contact me, Bruce Feist, on Compuserve with any bug   }
{ reports, enhancement requests, or general suggestions.  My ID is       }
{ 71320,3635; you can reach me on the BPROGA forum.                      }

{   I hope this proves useful to you all.  }

{  ***************  }

{  BufferIO Unit Description }
{  Purpose:                  }

{  This unit buffers reads done to any untyped file with a record length }
{ of 1.  The buffer size used is 9K.                                     }

{  Usage:  }

{  Just put a USES clause for the unit into any program or unit which     }
{ you want to buffer the reads on.  Make sure that ALL units referring to }
{ the file have the USES, otherwise you'll have problems.                 }

{  Compatability: }

{    BufferIO has been tested under TP 5.5.  It should work on all }
{ versions of TP from 4.0 up.                                      }

INTERFACE

USES DOS;

TYPE
  TByteArray = ARRAY [0 .. MaxInt] OF byte;
  PByteArray = ^TByteArray;

  TBuffFileRec =
    RECORD
      Handle: Word;
      Mode:   Word;
      RecSize: Word;
      Private: ARRAY[1 .. 26] OF byte;
      BufferPtr: PByteArray;
      BufferPos: Word;
      UsedBytes: Word;
      BufferSize: Word;
      ReqRecSize: Word;
      Dirty: Boolean;
      UserData: ARRAY [1 .. 3] OF byte;
      Name: ARRAY[0 .. 79] OF char;
    END;  { TBuffFileRec }


PROCEDURE ReSet   (VAR FileID: FILE; OpenRecSize: Word);
PROCEDURE ReWrite (VAR FileID: FILE; OpenRecSize: Word);
PROCEDURE Close   (VAR FileID: FILE);

PROCEDURE BlockRead  (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
PROCEDURE BlockWrite (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
PROCEDURE Seek       (VAR FileID: FILE; n: longint);
FUNCTION  FilePos    (VAR FileID: FILE): longint;
FUNCTION  EOF         (VAR FileID: FILE): Boolean;


IMPLEMENTATION

CONST
  BuffSize = 9 * 1024;  { 1 diskette track }


FUNCTION Min (x, y: word): word;
BEGIN { min }
  IF x > y
    THEN Min := y
    ELSE Min := x
END;  { Min }


PROCEDURE BFlush (VAR FileID: FILE);
BEGIN { BFlush }
  WITH TBuffFileRec(FileID) DO
    BEGIN
      Dirty := FALSE;
    END;  { WITH }
END;  { BFlush }


PROCEDURE ReSet (VAR FileID: FILE; OpenRecSize: Word);
BEGIN { ReSet }
  System.ReSet (FileID, OpenRecSize);
  IF OpenRecSize = 1 THEN
    WITH TBuffFileRec(FileID) DO
      BEGIN
        Writeln ('Opened for buffered reading!');
        GetMem (BufferPtr, BuffSize);
        BufferSize := BuffSize;
        UsedBytes := 0;
        BufferPos := 0;
        ReqRecSize := OpenRecSize;
        Dirty := False;
      END;  { WITH }
END;  { ReSet }


PROCEDURE ReWrite (VAR FileID: FILE; OpenRecSize: Word);
BEGIN { ReWrite }
  System.ReWrite (FileID, 1);
  IF OpenRecSize = 1 THEN
    WITH TBuffFileRec(FileID) DO
      BEGIN
        Writeln ('Opened for buffered writing!');
        GetMem (BufferPtr, BuffSize);
        BufferSize := BuffSize;
        UsedBytes := 0;
        BufferPos := 0;
        ReqRecSize := OpenRecSize;
        Dirty := False;
      END;  { WITH }
END;  { ReWrite }


PROCEDURE Close (VAR FileID: FILE);
BEGIN { Close }
  IF TBuffFileRec (FileID).ReqRecSize = 1 THEN
    BEGIN
      BFlush (FileID);
      WITH TBuffFileRec (FileID) DO
        BEGIN
          FreeMem (BufferPtr, BufferSize);
          BufferSize := 0;
          UsedBytes := 0;
          BufferPos := 0;
        END;  { WITH }
    END;  { IF ReqRecSize }
  System.Close (FileID);
END;  { Close }


PROCEDURE BlockRead (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
CONST
  FirstTime: Boolean = True;
VAR
  SoFar, BytesFromBuff, ReqBytes: Word;

BEGIN { BlockRead }
  WITH TBuffFileRec(FileID) DO
    IF ReqRecSize = 1 THEN
      BEGIN
        IF FirstTime THEN
          BEGIN
            Writeln ('First buffered read');
            FirstTime := False;
          END;
        ReqBytes := count * ReqRecSize;
        BytesFromBuff := min (ReqBytes, UsedBytes - BufferPos);
        Move (BufferPtr^[BufferPos], Buf, BytesFromBuff);
        Inc (BufferPos, BytesFromBuff);
        SoFar := BytesFromBuff;
        IF Dirty THEN
          BEGIN
            BFlush (FileID);
          END;

        WHILE SoFar < ReqBytes DO
          BEGIN
            IF Dirty
              THEN BFlush (FileID);
            System.BlockRead (FileID, BufferPtr^, BufferSize, UsedBytes);
            BytesFromBuff := min (ReqBytes - SoFar, UsedBytes);
            Move (BufferPtr^, PByteArray(@Buf)^[SoFar], BytesFromBuff);
            BufferPos := BytesFromBuff;
            Inc (SoFar, BytesFromBuff);
          END  { WHILE SoFar }
      END  { IF ReqRecSize }
    ELSE
      System.BlockRead (FileID, Buf, Count, Result);
END;  { BlockRead }


PROCEDURE BlockWrite (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
CONST
  FirstTime: Boolean = True;

BEGIN { BlockWrite }
  WITH TBuffFileRec (FileID) DO
    IF ReqRecSize = 1 THEN
      BEGIN
        IF FirstTime THEN
          BEGIN
            Writeln ('First Buffered Write');
            FirstTime := False;
          END;
        System.Seek (FileID, System.FilePos(FileID) + BufferPos);
        System.BlockWrite (FileID, Buf, Count, Result);
        TBuffFileRec(FileID).Dirty := True;
        BufferPos := 0;
        UsedBytes := 0;
      END
    ELSE
      System.BlockWrite (FileID, Buf, Count, Result);
END;  { BlockWrite }


PROCEDURE Seek (VAR FileID: FILE; n: longint);
BEGIN { Seek }
  WITH TBuffFileRec (FileID) DO
    IF ReqRecSize = 1 THEN
      BEGIN
        BFlush (FileID);
        System.Seek (FileID, n);
        BufferPos := 0;
        UsedBytes := 0;
      END
    ELSE
      System.Seek (FileID, n);
END;  { Seek }


FUNCTION FilePos (VAR FileID: FILE): longint;
VAR
  Result: Longint;

BEGIN { FilePos }
  WITH TBuffFileRec (FileID) DO
    IF ReqRecSize = 1 THEN
      BEGIN
        Result := System.FilePos (FileID)
           - UsedBytes + TBuffFileRec(FileID).BufferPos;
      END
    ELSE
      Result := System.FilePos (FileID);

  FilePos := Result;
END;  { FilePos }


FUNCTION EOF (VAR FileID: FILE): boolean;
VAR
  Result: Boolean;
BEGIN { EOF }
  WITH TBuffFileRec (FileID) DO
    IF ReqRecSize = 1 THEN
      Result := (BufferPos >= UsedBytes) AND System.EOF(FileID)
    ELSE
      Result := System.EOF(FileID);
  EOF := Result;
END;  { EOF }


BEGIN { BufferIO }
END.  { BufferIO }